home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: delta / whiteline CD Series - delta.iso / progtool / modula2 / module / sounds.mod < prev    next >
Text File  |  1995-11-25  |  3KB  |  86 lines
  1. IMPLEMENTATION MODULE Sounds;
  2.  
  3. FROM SYSTEM IMPORT VAL,ADR, SHIFT;
  4. FROM XBIOS104 IMPORT GIRead,GIWrite,DoSound;
  5.  
  6. VAR i : CARDINAL;
  7. (* Kanal 1..3 des Soundchips *)
  8. PROCEDURE Wave(Kanal,Kurve,Dauer :CARDINAL);
  9. VAR LowByte : BITSET;
  10. BEGIN
  11.   IF (Kanal<4) AND (Kanal>0) THEN
  12.     GIWrite (8+Kanal-1,16);  (* Lautstärke durch Hüllkurve gesteuert *)
  13.     LowByte:=VAL(BITSET,Dauer)*VAL(BITSET,0FFH);
  14.     GIWrite (13,Kurve);
  15.     GIWrite (11,VAL(CARDINAL,LowByte));
  16.     GIWrite (12,SHIFT(Dauer, - 8));
  17.   END(*IF*);
  18. END Wave;
  19.  
  20.  
  21. PROCEDURE Sound(Kanal,Periode:CARDINAL);
  22. VAR LowByte : BITSET;
  23. BEGIN
  24.   IF (Kanal<4) AND (Kanal>0) THEN
  25.     LowByte:=VAL(BITSET,Periode)*VAL(BITSET,0FFH);
  26.     GIWrite ((Kanal-1)*2,VAL(CARDINAL,LowByte));    (* Lowbyte *)
  27.     GIWrite ((Kanal-1)*2+1,SHIFT(Periode,- 8));  (* Highbyte *)
  28.   END(*IF*);
  29. END Sound;
  30.  
  31.  
  32. PROCEDURE Volume(Kanal,Vol:CARDINAL);
  33. (* Werte von 0..15 möglich *)
  34. BEGIN
  35.   IF (Kanal<4) AND (Kanal>0) THEN
  36.     Kanal:=Kanal-1+8;
  37.     GIWrite(Kanal,Vol);
  38.  END(*IF*);
  39. END Volume;
  40.  
  41. PROCEDURE Noise(Hoehe:CARDINAL);
  42. VAR Gesetzt : CARDINAL;
  43. BEGIN
  44.    GIWrite(6,Hoehe); (* Nur Werte von 0..31 sinnvoll *)
  45. END Noise;
  46.  
  47. PROCEDURE SetSoundAndNoise(NoiseChanels,SoundChanels:Chanel);
  48. (* Mit NoiseChanels bzw SoundChanels wird angegeben    *)
  49. (* welche der Ton- oder Rauschkanäle ausgeschaltet !!  *)
  50. (* werden                                              *)
  51. (* Zu jedem Tonkanal kann Rauschen dazugemischt werden *)
  52. VAR KanalFlag :CARDINAL;
  53. BEGIN
  54.     KanalFlag:=0C0H; (* Bits 6 und 7 müssen gesetzt sein *)
  55.     KanalFlag:=KanalFlag+VAL(CARDINAL,SoundChanels); (* Bits 0,1,2 schalten Oszilatoren ein    *)
  56.     KanalFlag:=KanalFlag+SHIFT(VAL(CARDINAL,NoiseChanels),3); (* Bit 3,4,5 gibt an ob ein      *)
  57.                                              (* Rauschkanal dazugemischt wird *)
  58.     GIWrite(7,KanalFlag);
  59. END SetSoundAndNoise;
  60.  
  61.  
  62. PROCEDURE SoundAndNoiseOnOff(NoiseFlag,SoundFlag:CARDINAL);
  63. (* Eigendlich dieselbe PROCEDURE wie SetSoundAndNoise *)
  64. (* Nur das hier ein CARDINAL anstelle des SETs        *)
  65. (* übergeben wird.                                    *)
  66. (* KanalFlag := 0 => Kanal 1, 2 u. 3 an     *) (*000*)
  67. (* KanalFlag := 1 => Kanal 1 aus, 2 u. 3 an *) (*001*)
  68. (* KanalFlag := 2 => Kanal 2 aus, 1 u. 3 an *) (*010*)
  69. (* KanalFlag := 3 => Kanal 1 u. 2 aus, 3 an *) (*011*)
  70. (* KanalFlag := 4 => Kanal 3 aus, 1 u. 2 an *) (*100*)
  71. (* KanalFlag := 5 => Kanal 1 u. 3 aus, 2 an *) (*101*)
  72. (* KanalFlag := 6 => Kanal 3 u. 2 aus, 1 an *) (*110*)
  73. (* KanalFlag := 7 => Kanal 1, 2 u. 3 aus    *) (*111*)
  74. VAR KanalFlag :CARDINAL;
  75. BEGIN
  76.   IF (NoiseFlag<8) AND (SoundFlag<8) THEN (* Nur keinen Unsinn hineinschreiben!*)
  77.     KanalFlag:=0C0H; (* Bits 6 und 7 müssen gesetzt sein *)
  78.     KanalFlag:=KanalFlag+SoundFlag; (* Bits 0,1,2 schalten Oszilatoren ein    *)
  79.     KanalFlag:=KanalFlag+SHIFT(NoiseFlag,3); (* Bit 3,4,5 gibt an ob ein      *)
  80.                                              (* Rauschkanal dazugemischt wird *)
  81.     GIWrite(7,KanalFlag);
  82.   END(*IF*);
  83. END SoundAndNoiseOnOff;
  84.  
  85. END Sounds.
  86.